﻿module SymbolTableGenerator


open System.Collections.Generic
open SymbolTableTypes
open MaybeMonad
open TypeEnvironment
open Ast
open TypeRules

type Dictionary<'a, 'b> with
  member this.Add_Safe (a, v, info) =
    if this.ContainsKey(a) |> not then
      this.Add (a, v)
    else
      failwith ("Name already exists in: " + info)
      
(*
  let private buildBodyTable (class_table : ClassTable) (m_decl : FieldOrMethodDecl) = 
    let (MethodDecl (return_ty, meth_name, args, block)) = m_decl

    let body_table = 
      {
        Name = meth_name
        Container = class_table
        Args = Dictionary<string, BodySymbol>()
        ReturnType = return_ty
        Block = None      
      }

    let block_table =
      {
        Parent        = Body body_table
        Symbols       = Dictionary<string, BodySymbol>()
        Block         = block
        Children      = List<BlockTable>()
      }

 
    let addArg (Arg(ty, id)) =
      body_table.Args.Add_Safe(id, { Name = id; Type = ty }, "method " + meth_name + ", argument " + id)
    do args |> List.iter (fun arg -> addArg arg)


        let add_vars vars n =
          vars |> Seq.iter (
                    fun (VarDecl.VarDecl(ty, id, ids)) -> 
                      let addVar (id, _) =
                        body_table.Args.Add_Safe(id, { Name = id; Type = ty }, "method " + meth_name + ", variable " + id)
                      addVar id
                      ids |> Seq.iter (fun id -> addVar id)              
                      )
        do add_vars vars 0
        let rec bubble_up stmt n =
          match stmt with
            | While (_, stmt) -> bubble_up stmt n
            | If (_, stmt1, None) -> bubble_up stmt1 n
            | If (_, stmt1, Some stmt2) -> 
              do bubble_up stmt1 n
              do bubble_up stmt2 n
            | Stmt.Block (Block.Block (vars, stmts)) -> 
              do add_vars vars (n + 1)
              stmts |> Seq.iter (fun stmt -> bubble_up stmt (n + 1))
            | _ -> ()
    
        stmts |> Seq.iter(fun s -> bubble_up s 0)

    { body_table with Block = Some block_table }
*)


let private buildClassTable (global_symbol : GlobalSymbols) (name : string) (inherited : id option) (fields : FieldOrMethodDecl list) :ClassTable =
  let classTable = 
    { 
      Name = name;
      Parent = global_symbol;
      Inherited = 
        match inherited with
          | None -> Some "$null$"
          | Some inherited_name -> 
            if global_symbol.ContainsKey inherited_name then
              Some inherited_name
            else
              failwith "Extended classes must be defined above"
      Methods = Dictionary<string, MethodSymbol>()
      Fields = Dictionary<string, FieldSymbol>()
      ObjectLayout    = ResizeArray()
      DispatchVector  = ResizeArray()
    }

  for fieldOrMethod in fields do
    match fieldOrMethod with
      | FieldDecl (ty, id, ids, _) -> 
        let addSymbol id =
          let names = 
            match classTable.Inherited with
            | Some name -> get_inherited_field_names (SymbolTableTypes.GenericTable.ClassTable global_symbol.[name])
            | None -> []
          if names |> Seq.exists ((=) id) then
            failwith (sprintf "%s already exist in superclass" id)
          classTable.Fields.Add_Safe(id, { Name = id; Type = ty }, "class " + name + ", field " + id)
        addSymbol id
        ids |> Seq.iter (fun id -> addSymbol id)
      | MethodDecl (return_ty, id, args, block, _) as method_decl -> 
        let ty_args = args |> List.map (fun (Arg(ty, _)) -> ty)
        let methods = 
          match classTable.Inherited with
          | Some name -> get_inherited_methods (SymbolTableTypes.GenericTable.ClassTable global_symbol.[name])
          | None -> []
        if methods |> Seq.exists (fun m -> m.Name = id) then
          let (tys, ret, _) = (methods |> Seq.find (fun m -> m.Name = id)).Infos
          let rec check tys1 tys2 =
            match tys1, tys2 with
            | [], [] -> true
            | t1::ts1, t2::ts2 ->
              if t1 = t2 then
                check ts1 ts2
              else
                false
            | _ -> false
          if ((check ty_args tys) && return_ty = ret) |> not then
           failwith "arguments and return type must be equal in overrited methods"
        classTable.Methods.Add_Safe(id, { Name = id; Infos = ( ty_args, return_ty, ref None)}, "class " + name + ", method " + id)

  classTable


let private buildGlobalSymbolTable (ast:Program) : GlobalSymbols =
  let globalSymbol = (Dictionary<string, ClassTable>())
  globalSymbol.Add ("$null$",
                   { 
                      Name = "$null$";
                      Parent = globalSymbol;
                      Inherited = None
                      Fields = Dictionary<string, FieldSymbol>()
                      Methods = Dictionary<string, MethodSymbol>()
                      ObjectLayout    = ResizeArray()
                      DispatchVector  = ResizeArray()
                    })
  for (ClassDecl(name, inherited, fields)) as class_decl in ast do
    let class_table = buildClassTable globalSymbol name inherited fields
    do globalSymbol.Add_Safe(name, class_table, "Class " + name)  

  // controllo esistenza classe ereditate

  globalSymbol

let type_check_Program (prg : Ast.Program) = 
  let global_symbol_table = buildGlobalSymbolTable prg
  let tables = List<GenericTable>([global_symbol_table] |> Seq.map (GenericTable.GlobalSymbols))
  let res = execute (check_program prg) ({ Tables = tables; WhileCounter = ref 0; AliasCounter = ref 1; LineNumber = 0 })
  match res with
  | MaybeOrFail.Fail error ->
    failwith (error.Replace("$null$", "object"))
  | MaybeOrFail.Just (_, res) ->
    res.Tables.Head |> get_global_table
